﻿namespace nGo

type Singleton<'T when 'T : not struct>() =
    
    let mutable isRegistered = false
    let mutable internalValue = Operators.defaultArg<'T>

    let singletonLock = obj()
    
    member x.Value
        with get() = 
            lock singletonLock (fun() ->
                match isRegistered with
                | true -> internalValue 
                | false -> failwith("Access to unregistered singleton. Register singleton before accessing its value."))
        and set(value) = 
            lock singletonLock (fun() ->
                internalValue <- value
                isRegistered <- true)

    member x.IsRegistered with get() = isRegistered

type SingletonDelegate<'T when 'T : not struct>(getDelegate:System.Func<'T>, setDelegate:System.Action<'T>, requireSetInvocation:bool) =
    
    let mutable isSetInvoked = false

    let internalGet = getDelegate
    let internalSet = setDelegate

    let singletonLock = obj()

    new(getDelegate:System.Func<'T>, setDelegate:System.Action<'T>) = SingletonDelegate<'T>(getDelegate, setDelegate, false)
    
    member x.Value
        with get() = 
            lock singletonLock (fun() -> 
                match (isSetInvoked,requireSetInvocation) with
                | (false,true) -> failwith("Singleton delegate requires its Value be explicitly set before accessing the Value.")
                | (_,_) -> internalGet.Invoke())
        and set(value) = lock singletonLock (fun() -> internalSet.Invoke(value); isSetInvoked <- true)

    member x.IsSetInvoked with get() = isSetInvoked

type SingletonAction(action:System.Action, throwExceptionOnSubsequentInvocations:bool) =
    
    let mutable isInvoked = false
    
    let internalAction = action
    let internalThrowExceptionOnSubsequentInvocations = throwExceptionOnSubsequentInvocations
    let singletonLock = obj()

    new(action:System.Action) = SingletonAction(action, true)

    member x.Invoke() =
        lock singletonLock (fun() ->
            match (isInvoked,internalThrowExceptionOnSubsequentInvocations) with
            | (true,true) -> failwith("Action is a singleton and has been previously invoked.")
            | (true,false) -> () // already invoked
            | (false,_) ->
                internalAction.Invoke()
                isInvoked <- true)
        isInvoked

    member x.IsInvoked with get() = isInvoked

module public Services = begin
    open System
    open System.Collections.Generic

    [<AbstractClass>]
    type LocatorBase() =
        abstract member Get<'T> : unit -> 'T
        abstract member Get<'T> : string -> 'T
        abstract member Get : Type -> obj
        abstract member Get : Type * string -> obj
        abstract member GetAll<'T> : unit -> IEnumerable<'T>
        abstract member GetAll : Type -> IEnumerable<obj>
    
    type Locator(getLocator:Func<Microsoft.Practices.ServiceLocation.IServiceLocator>) =
        inherit LocatorBase()

        new() = Locator((fun() -> Microsoft.Practices.ServiceLocation.ServiceLocator.Current))
        
        new(locator:Microsoft.Practices.ServiceLocation.IServiceLocator) = Locator((fun() -> locator))

        member private x.Locator with get() = getLocator.Invoke()

        override x.Get<'T>() = x.Locator.GetInstance<'T>()
        override x.Get<'T>(key) = x.Locator.GetInstance<'T>(key)
        override x.Get(t) = x.Locator.GetInstance(t)
        override x.Get(t, key) = x.Locator.GetInstance(t, key)
        override x.GetAll() = x.Locator.GetAllInstances<'T>()
        override x.GetAll(t) = x.Locator.GetAllInstances(t)

    let mutable internal globalLocator = Locator()

    let public GlobalLocator = SingletonDelegate((fun() -> globalLocator), (fun(value) -> globalLocator <- value))
end

module public Models = begin
    open System.ComponentModel.Composition

    [<InheritedExport>]
    [<AbstractClass>]
    type ModelProvider<'TModel when 'TModel : not struct>() =
        abstract member GetModel : unit -> 'TModel

    [<InheritedExport>]
    [<AbstractClass>]
    type ModelProvider<'TRequest, 'TModel when 'TRequest : not struct and 'TModel : not struct>() =
        abstract member GetModel : 'TRequest -> 'TModel

    type ModelFactory(locator:Services.LocatorBase) =
        let internalLocator = locator

        new() = ModelFactory(Services.GlobalLocator.Value)

        member x.GetModel<'TModel when 'TModel : not struct>() =
            let provider = internalLocator.Get<ModelProvider<'TModel>>()
            provider.GetModel()

        member x.GetModel<'TRequest, 'TResponse when 'TRequest : not struct and 'TResponse : not struct>(req:'TRequest) =
            let provider = internalLocator.Get<ModelProvider<'TRequest, 'TResponse>>()
            provider.GetModel(req)
end

module public Mef = begin
    open System
    open System.Linq
    open System.ComponentModel.Composition
    open System.ComponentModel.Composition.Hosting

    type ServiceLocator(exportProvider:ExportProvider) =
        inherit Microsoft.Practices.ServiceLocation.ServiceLocatorImplBase()
        
        /// The =~ operator is called a null-coalescing operator 
        /// and is used to define a default value for nullable 
        /// value types or reference types. It returns the 
        /// left-hand operand if the operand is not null; 
        /// otherwise it returns the right operand.
        let (=~) left right = 
            match left with 
            | null -> right
            | _ -> left

        let provider = exportProvider

        override x.DoGetInstance(serviceType:Type, key:string) =
            let lookupKey = key =~ AttributedModelServices.GetContractName(serviceType)

            let exports = provider.GetExports<obj>(lookupKey)
        
            match exports.Any() with
            | true -> 
                exports 
                    |> Seq.head 
                    |> (fun export -> export.Value)
            | false ->
                let errorMessage = sprintf "Could not locate any instances of contract %s" lookupKey
                raise (Microsoft.Practices.ServiceLocation.ActivationException(errorMessage))
        
        override x.DoGetAllInstances(serviceType:Type) =
            let key = AttributedModelServices.GetContractName(serviceType)
            let exports = provider.GetExportedValues<obj>(key)
            exports
end